home *** CD-ROM | disk | FTP | other *** search
/ Delphi Magazine Collection 2001 / Delphi Magazine Collection 20001 (2001).iso / DISKS / Issue62 / Alfresco / TestAAHpDbug.dpr < prev    next >
Encoding:
Text File  |  2000-09-02  |  2.6 KB  |  105 lines
  1. program TestAAHpDbug;
  2.  
  3. {$APPTYPE CONSOLE}
  4.  
  5. uses
  6.   AAHpDbug in 'AAHpDbug.pas',
  7.   SysUtils;
  8.  
  9. var
  10.   PtrArray : array [0..127] of pointer;
  11.   i        : integer;
  12.   Size     : integer;
  13.   SavedMem : array [0..31] of byte;
  14.  
  15. begin
  16.   writeln('Testing AAHpDbug...');
  17.   try
  18.  
  19.  
  20.     {at this point the replacement heap manager should be installed}
  21.     Assert(IsMemoryManagerSet, 'Heap manager has not been replaced');
  22.  
  23.     writeln('allocate 128 pointers');
  24.     for i := 0 to 127 do begin
  25.       Size := Random(512) + 1;
  26.       GetMem(PtrArray[i], Size);
  27.       FillChar(PtrArray[i]^, Size, Random(26) + ord('a'));
  28.     end;
  29.  
  30.     writeln('free every even element');
  31.     for i := 0 to 127 do
  32.       if not Odd(i) then begin
  33.         FreeMem(PtrArray[i]);
  34.         PtrArray[i] := nil;
  35.       end;
  36.  
  37.     writeln('reallocate every odd element');
  38.     for i := 0 to 127 do
  39.       if Odd(i) then begin
  40.         Size := Random(512) + 1;
  41.         ReallocMem(PtrArray[i], Size);
  42.         FillChar(PtrArray[i]^, Size, Random(26) + ord('a'));
  43.       end;
  44.  
  45.     writeln('free every odd element');
  46.     for i := 0 to 127 do
  47.       if Odd(i) then begin
  48.         FreeMem(PtrArray[i]);
  49.         PtrArray[i] := nil;
  50.       end;
  51.  
  52.     writeln('perform a memory overwrite at the end');
  53.     GetMem(PtrArray[0], 29);
  54.     FillChar(PtrArray[0]^, 30, $11);
  55.     FreeMem(PtrArray[0]);
  56.  
  57.     writeln('perform a memory overwrite at the start');
  58.     GetMem(PtrArray[0], 29);
  59.     dec(PChar(PtrArray[0]), 2);
  60.     FillChar(PtrArray[0]^, 29, $11);
  61.     inc(PChar(PtrArray[0]), 2);
  62.     FreeMem(PtrArray[0]);
  63.  
  64.     writeln('dispose of a pointer twice');
  65.     GetMem(PtrArray[0], 32);
  66.     FreeMem(PtrArray[0]);
  67.     try
  68.       FreeMem(PtrArray[0]);
  69.     except
  70.     end;
  71.  
  72.     writeln('write to a pointer after freeing it');
  73.     GetMem(PtrArray[0], 32);
  74.     FillChar(PtrArray[0]^, 32, Random(26) + ord('a'));
  75.     GetMem(PtrArray[1], 32);
  76.     FillChar(PtrArray[1]^, 32, Random(26) + ord('a'));
  77.     FreeMem(PtrArray[0]);
  78.     try
  79. //      Move(PtrArray[0]^, SavedMem, 32);
  80.       FillChar(PtrArray[0]^, 32, 'A');
  81.       FreeMem(PtrArray[1]);
  82.     except
  83.     end;
  84. //    Move(SavedMem, PtrArray[0]^, 32);
  85.  
  86.  
  87.     writeln('cause a couple of memory leaks');
  88.     Size := Random(128) + 1;
  89.     GetMem(PtrArray[0], Size);
  90.     FillChar(PtrArray[0]^, Size, Random(26) + ord('a'));
  91.     Size := Random(128) + 1;
  92.     GetMem(PtrArray[1], Size);
  93.     FillChar(PtrArray[1]^, Size, Random(26) + ord('a'));
  94.  
  95.     writeln('done');
  96.  
  97.  
  98.   except
  99.     on E : Exception do
  100.       writeln(E.Message);
  101.   end;
  102.   write('Press Enter to close...');
  103.   readln;
  104. end.
  105.